{
	UCE - cross-platform game engine written in delphi.
	Copyright (c) 2009, Shutko Vitaly

	This file is part of UCE.

	UCE is free software; you can redistribute it and/or
	modify it under the terms of the GNU Lesser General Public
	License as published by the Free Software Foundation; either
	version 2.1 of the License, or (at your option) any later version.

	UCE is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
	Lesser General Public License for more details.

	You should have received a copy of the GNU Lesser General Public
	License along with this library; if not, write to the Free Software
	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
}

unit uSndDS;

interface

uses
  Math, MMSystem, uDirectSound, uTyp, uSnd;

type
  TSndBufDS = class(TSndBuf)
    buf: IDirectSoundBuffer;
    flags: Cardinal;

    procedure Play(loop: Boolean = False); override;
    procedure Pause; override;
    procedure Resume; override;
    procedure Stop; override;
    function Playing: Boolean; override;

    procedure SetVolume(v: Integer); override;
    procedure SetPan(p: Integer); override;
    
    function Upload(data: TBytes; chans, bps, freq: Integer): Boolean; override;
    function Dublicate: TSndBuf; override;

    destructor Destroy; override;
  end;

  TSndManDS = class(TSndMan)
    snd: IDirectSound;
    buf: IDirectSoundBuffer;

    function Init: Boolean; override;

    destructor Destroy; override;
  end;

implementation

uses
  uVar, uAppWin32;

//////////////////////////////////////////////////////////////////////////////
///  TSndBufDS
//////////////////////////////////////////////////////////////////////////////

destructor TSndBufDS.Destroy;
begin
  if buf <> nil then buf := nil
end;

procedure TSndBufDS.Play(loop: Boolean = False);
begin
  playStart := tim.GetTime;

  if loop then flags := DSBPLAY_LOOPING else flags := 0;

  if buf <> nil then
  begin
    buf.SetCurrentPosition(0);
    buf.Play(0, 0, flags);
  end;
end;

procedure TSndBufDS.Pause;
begin
  if buf <> nil then
    buf.Stop;
end;

procedure TSndBufDS.Resume;
begin
  if buf <> nil then
    buf.Play(0, 0, flags);
end;

procedure TSndBufDS.Stop;
begin
  if buf <> nil then
  begin
    buf.Stop;
    buf.SetCurrentPosition(0);
  end;
end;

function TSndBufDS.Playing: Boolean;
var
  status: Cardinal;
begin
  Result := False;

  if buf <> nil then
  begin
    buf.GetStatus(status);
    Result := (status = DSBSTATUS_PLAYING) or (status = DSBSTATUS_LOOPING);
  end;
end;

procedure TSndBufDS.SetVolume(v: Integer);
begin
  if v < 0 then v := 0;
  if v > 100 then v := 100;
  
  volume := v;

  if buf <> nil then
    if v = 0 then buf.SetVolume(-10000) else buf.SetVolume(-Round(1000 * Ln( 100 / v)));
end;

procedure TSndBufDS.SetPan(p: Integer);
begin
  if buf <> nil then
    buf.SetPan(p * 100);
end;

function TSndBufDS.Upload(data: TBytes; chans, bps, freq: Integer): Boolean;
var
  desc: TDSBufferDesc;
  fmt: TWaveFormatEx;
  ptr1, ptr2: Pointer;
  bytes1, bytes2: Cardinal;
  res: Integer;
begin
  Result := False;

  with fmt do
  begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := chans;
    nSamplesPerSec := freq;
    nBlockAlign:= chans * bps div 8;
    nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
    wBitsPerSample := bps;
    cbSize := 0;
  end;

  FillChar(desc, SizeOf(TDSBufferDesc), 0);

  with desc do
  begin
    dwSize := SizeOf(TDSBufferDesc);
    dwFlags := DSBCAPS_STATIC or DSBCAPS_CTRLPAN or DSBCAPS_CTRLVOLUME;
    dwBufferBytes := Length(data);
    lpwfxFormat := @fmt;
  end;

  res := TSndManDS(snd).snd.CreateSoundBuffer(desc, buf, nil);

  if res <> DS_OK then
  begin
    //error
    Exit;
  end;

  res := buf.Lock(0, Length(data), @ptr1, @bytes1, @ptr2, @bytes2, 0);

  if res = DSERR_BUFFERLOST then
  begin
   buf.Restore;

   if buf.Lock(0, Length(data), @ptr1, @bytes1, @ptr2, @bytes2, 0) <> DS_OK then
   begin
     //error
     Exit;
   end;
  end else

  if res <> DS_OK then
  begin
    //error
    Exit;
  end;

  Move(data[0], ptr1^, bytes1);

  if ptr2 <> nil then
    Move(data[bytes1], ptr2^, bytes2);

  buf.UnLock(ptr1, bytes1, ptr2, bytes2);

  Result := True;
end;

function TSndBufDS.Dublicate: TSndBuf;
begin
  Result := TSndBufDS.Create;

  if TSndManDS(snd).snd.DuplicateSoundBuffer(buf, TSndBufDS(Result).buf) <> DS_OK then
  begin
    //error
    Result.Free;
    Result := nil;
  end;
end;

//////////////////////////////////////////////////////////////////////////////
///  TSndManDS
//////////////////////////////////////////////////////////////////////////////

destructor TSndManDS.Destroy;
begin
  if buf <> nil then buf := nil;
  if snd <> nil then snd := nil;
end;

function TSndManDS.Init: Boolean;
var
  fmt: TWaveFormatEx;
  desc: TDSBufferDesc;
begin
  Result := False;

  if not InitDirectSound then
  begin
    //error
    Exit;
  end;

  if DirectSoundCreate(nil, snd, nil) <> DS_OK then
  begin
    //error
    Exit;
  end;

  if snd.SetCooperativeLevel(TAppWin32(app).wnd, DSSCL_PRIORITY) <> DS_OK then
  begin
    //error
    Exit;
  end;

  FillChar(desc, SizeOf(TDSBufferDesc), 0);

  with desc do
  begin
    dwSize := SizeOf(TDSBufferDesc);
    dwFlags := DSBCAPS_PRIMARYBUFFER;
    dwBufferBytes := 0;
    lpwfxFormat := nil;
  end;

  if snd.CreateSoundBuffer(desc, buf, nil) <> DS_OK then
  begin
    //error
    Exit;
  end;

  FillChar(fmt, SizeOf(TWaveFormatEx),0);

  with fmt do
  begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := 2;
    nSamplesPerSec := 44100;
    nBlockAlign := 4;
    nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
    wBitsPerSample := 16;
    cbSize := 0;
  end;

  if buf.SetFormat(@fmt) <> DS_OK then
  begin
    //error
    Exit;
  end;

  opened := True;

  Result := True;
end;

end.